home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbhelp2.arc / QBHELP.ASC next >
Encoding:
Text File  |  1988-04-04  |  4.6 KB  |  123 lines

  1. DECLARE SUB GET.MONITOR (Monitor%)
  2.  
  3.      ' Memory resident QB help program Alt-X activates
  4.      ' by Kauko J. Laurinolli  Apr. 2, 1988   404-981-9550
  5.      ' Assembly Subroutines  : Mach2 V2.00 and Stayres Plus  from Micro-Help
  6.      ' Screens generated with: OSG   V1.05 from Inventories Unlimited
  7.      ' Compiled with QB4
  8.      ' BC qbhelp.asc/o;
  9.      ' LINK stayqb4+qbhelp+nocom+dispscr2,,nul,qbhelp.lib+mhlib2+bcom40 /E;
  10.  
  11.      DEFINT A-Z
  12.  
  13.      CALL GET.MONITOR(Last.Monitor)                              'get monitor type
  14.  
  15.      Scr.Buffer$ = SPACE$(16404)                                 'space for screen image
  16.      Kshift = VARPTR(Scr.Buffer$)                                'get segment address
  17.      CALL Stayres(3, Kscan, Kshift, Ecode)                       'initiate
  18.  
  19.      Kscan = 16 * 1024                                           'screen buffer inside basic
  20.      CALL Stayres(4, Kscan, Kshift, Ecode)
  21.  
  22.      Kscan = 45: Kshift = 8: Oper = 0                          'kscan = hotkey
  23.      CALL Mhscr("Programmers Help Loaded, use Alt-X to Activate", 0, CSRLIN, 1, 15)
  24.  
  25. HOT.KEY:
  26.      CALL Stayres(Oper, Kscan, Kshift, Ecode)                    'go to sleep
  27.  
  28.      CALL GET.MONITOR(Monitor)                                   'check monitor type
  29.  
  30.      IF Last.Monitor <> Monitor THEN                             'change video mode
  31.           CALL Stayres(2, Kscan, Kshift, Ecode)
  32.           Last.Monitor = Monitor
  33.      END IF
  34.  
  35.      CALL Colr                                                   'show main screen
  36.      CALL Ascii1                                                 'show 1st ascii table
  37.      Curr.Key = 1: Mss$ = SPACE$(10)
  38.  
  39.      CALL Mhscr(" Programmers Help by K. Laurinolli    <Esc> <Esc> to Quit         PgUp  PgDn  ", 0, 25, 1, 78)
  40.      Old.Scan = 0                                                'clear old.scan
  41.  
  42. DO
  43.      Shft = 0
  44.      CALL MhKclr(&H1600, 0, 1, 1, Shift, Scan, Ascii)            'get curr.key
  45.  
  46.      IF (Shift AND 1) = 1 THEN Shft = Shft + 1
  47.      IF (Shift AND 2) = 2 THEN Shft = Shft + 2
  48.      IF (Shift AND 4) = 4 THEN Shft = Shft + 4
  49.      IF (Shift AND 8) = 8 THEN Shft = Shft + 8
  50.  
  51.      FOR col = 13 TO 46 STEP 11
  52.           CALL Mhscr(Mss$, 0, 22, col, 51)                       'clear fields
  53.           CALL Mhscr(Mss$, 0, 23, col, 51)
  54.      NEXT
  55.  
  56.      CALL Mhscr(CHR$(Ascii), 0, 22, 17, 63)                      'char
  57.  
  58.      CALL Mhscr(STR$(Ascii), 0, 22, 28, 63)                      'ascii
  59.      CALL Mhscr(HEX$(Ascii), 0, 23, 29, 63)
  60.  
  61.      CALL Mhscr(STR$(Shft), 0, 22, 39, 63)                       'shift
  62.      CALL Mhscr(HEX$(Shft), 0, 23, 40, 63)
  63.  
  64.      CALL Mhscr(STR$(Scan), 0, 22, 49, 63)                       'scan
  65.      CALL Mhscr(HEX$(Scan), 0, 23, 50, 63)
  66.  
  67.      IF Ascii = 27 AND Shft = 4 AND Scan = 1 THEN                'leave program, REM this when finished programming
  68.         Oper = 9
  69.         EXIT DO
  70.      END IF
  71.  
  72.      IF Old.Scan = Scan AND Scan = 1 THEN                        'go back to sleep after <Esc><Esc>
  73.         EXIT DO
  74.      END IF
  75.  
  76.      IF Scan = 80 OR Scan = 81 OR Scan = 72 OR Scan = 73 THEN    'page ascii tables
  77.           IF Scan = 80 OR Scan = 81 THEN                         'page forward
  78.                IF Curr.Key < 6 THEN
  79.                     Curr.Key = Curr.Key + 1
  80.                ELSE
  81.                     Curr.Key = 1
  82.                END IF
  83.           END IF
  84.  
  85.           IF Scan = 72 OR Scan = 73 THEN                         'page backward
  86.                IF Curr.Key > 1 THEN
  87.                     Curr.Key = Curr.Key - 1
  88.                ELSE
  89.                     Curr.Key = 6
  90.                END IF
  91.           END IF
  92.  
  93.           IF Curr.Key = 1 THEN CALL Ascii1                       'show different ascii tables
  94.           IF Curr.Key = 2 THEN CALL ascii2
  95.           IF Curr.Key = 3 THEN CALL ascii3
  96.           IF Curr.Key = 4 THEN CALL ascii4
  97.           IF Curr.Key = 5 THEN CALL ascii5
  98.           IF Curr.Key = 6 THEN CALL ascii6
  99.      END IF
  100.  
  101.      Old.Scan = Scan                                             'set old keyscan
  102. LOOP
  103.  
  104.      GOTO HOT.KEY                                                'back to start
  105.  
  106.      END
  107.  
  108. SUB GET.MONITOR (Monitor) STATIC
  109.  
  110.      CALL mhdisplay(mode, columns, rows, memory, display.type)
  111.  
  112.      IF (display.type AND 128) = 128 THEN
  113.           Monitor = &HB800                                       '&hB800 for color &hFFFF for no snow-check
  114.      ELSE
  115.           Monitor = &HB000                                       'mono
  116.      END IF
  117.  
  118.      CALL mhvideo(Monitor)
  119.      IF Monitor = &HB800 THEN CALL mhvideo(&HFFFF)               'turn off snow checking on color monitors
  120.  
  121. END SUB         'get.monitor mono / color
  122.  
  123.